TeX 1995 July/TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO/dviware/dvidis/pxtopk_orig.vms-changes

Text File | 1990-10-01 | 11KB | 373 lines

From: Robert Bittl BITTL AT DGATUM5P
PXtoPK change file for Vax/VMS.
Robert Bittl, Physik-Department TU Muenchen
21 Oct 86
 7Dec87 JSL  .PKTOPX is now at Version 2.3.

@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\let\maybe=\iftrue
\def\title{PXtoPK changes for Vax/VMS}
@z

@x
@d banner=='This is PXtoPK, Version 2.3'
@y
@d banner=='This is PXtoPK, Vax/VMS Version 2.3'
@z

@x
@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@y
@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@d real == double
@z

@x
@p program PXtoPK(input, output);
@y
@p
@\@=[inherit('sys$library:starlet')]@>@\
program PXtoPK(@!pk_file,@!pxl_file,@!input,@!output);
@z

@x
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin print_ln(banner);@/
@y
@<Procedures for initialization@>@\
procedure initialize; {this procedure gets things started properly}
  var i:integer; {loop index for initializations}
  begin print_ln(banner);@/
  @<Preset initial values@>@\
@z

@x
@!word_file=packed file of integer; {for pixel file words}
@!byte_file=packed file of eight_bits ; {for packed file words}
@y
{later we'll define files that contain binary date}
@z

@x
@!pxl_file:word_file; {where the input comes from}
@!pk_file:byte_file;  {where the final output goes}
@y
@!pxl_file:packed file of int_block; {where to input comes from}
@!pk_file:packed file of byte_block; {where the final output goes}
@z

@x
begin reset(pxl_file,pxl_name);
@y
begin reset(pxl_file);
@z

@x
begin rewrite(pk_file,pk_name);
@y
begin rewrite(pk_file);
@z

@x
@!pk_loc:integer; {how many bytes have we sent?}
@y
@!pk_loc:integer; {how many bytes have we sent?}
@!pk_count:integer; {number of bytes read from current block of |pk_file|}
@z

@x
pk_loc := 0 ;
@y
pk_loc := 0 ; pk_count := 0 ;
@z

@x
@p function pixel_integer : integer ;
var i:integer;
begin i := pxl_file^ ;
get(pxl_file) ;
eof_pixel:=eof(pxl_file);
pixel_integer:=i;
end;
@y
This routine is not needed, as we do the buffering directly in the
pixel reading routine.

@ We also will need a procedure to flip the bytes around in case they are
backwards (as they almost always will be.

@p function flip(mixed: integer): integer ;

type
   select2=0..1 ;
   eight_bits=[byte]0..255 ;

var
   convert: record case select2 of
      0:(int: integer) ;
      1:(w_0, w_1, w_2, w_3: eight_bits) ;
   end ;
   temp: eight_bits ;

begin
   convert.int := mixed ;
   temp := convert.w_0 ;
   convert.w_0 := convert.w_3 ;
   convert.w_3 := temp ;
   temp := convert.w_1 ;
   convert.w_1 := convert.w_2 ;
   convert.w_2 := temp ;
   flip := convert.int ;
end ;
@z

@x
@ @p procedure pk_byte(b : integer) ;
begin
if b < 0 then b := b + 256 ;
pk_file^ := b ;
put(pk_file) ;
incr(pk_loc) ;
end ;
@y
@ @p procedure pk_byte(b : integer) ;
begin
if b < 0 then b := b + 256 ;
pk_file^[pk_count] := b ;
incr(pk_count);
if pk_count=VAX_block_length then begin
   put(pk_file) ;
   pk_count := 0 ;
end;
incr(pk_loc) ;
end ;
@z

@x
var k:integer; {index for word moves}
@y
var k:integer; {index for word moves}
    r:integer; {index for the pxl buffer}
@z

@x
   while not eof_pixel do begin
      mem[k] := pixel_integer ;
      k := k + 1 ;
      if k > max_mem_size then
         abort('PXtoPK memory size exceeded on load of pixel file!') ;
   end ;
@y
   while not eof(pxl_file) do begin
      if k + 128 > max_mem_size then
         abort('PXtoPK memory size exceeded on load of pixel file!') ;
      for r := 0 to 127 do begin
         mem[k] := pxl_file^[r] ; k := k + 1 ;
      end ;
      get(pxl_file, @=error@>:=@=continue@>) ;
   end ;
@z

@x
   if (mem[k] <> pxl_id) or (mem[0]<>pxl_id) then goto 9997 ;
@y
   if (mem[0]=flip(pxl_id)) then
      for r := 0 to k do
         mem[r] := flip(mem[r]) ;
   if mem[0]<>pxl_id then goto 9997 ;
   r := k ;
   while mem[k] <> pxl_id do
      k := k - 1 ;
   if r-k > 140 then goto 9997 ;
@z

@x
@* Terminal communication.
We must get the file names and determine whether output is to be in
hexadecimal or binary.  To do this, we use the standard input path
name.  We need a procedure to flush the input buffer.  For most systems,
this will be an empty statement.  For other systems, a |print_ln| will
provide a quick fix.  We also need a routine to get a line of input from
the terminal.  On some systems, a simple |read_ln| will do.  Finally,
a macro to print a string to the first blank is required.

@d flush_buffer == begin end
@d get_line(#) == if eoln(input) then read_ln(input) ;
   i := 1 ;
   while not (eoln(input) or eof(input)) do begin
      #[i] := input^ ;
      incr(i) ;
      get(input) ;
   end ;
   #[i] := ' '

@ @p procedure dialog ;
var i : integer ; {index variable}
buffer : packed array [1..name_length] of char; {input buffer}
begin
   for i := 1 to name_length do begin
      pxl_name[i] := ' ' ;
      pk_name[i] := ' ' ;
   end;
   print('Input file name:  ') ;
   flush_buffer ;
   get_line(pxl_name) ;
   print('Output file name:  ') ;
   flush_buffer ;
   get_line(pk_name) ;
   print_ln(' ') ;
end ;
@y
@* Terminal communication.
We must get the file names either from the command line or interactive.
in the latter case we use the standard input path name.

@ The task of the procedure dialog is done by the system specific routine
|Preset initial values|
@z

@x
initialize ;
dialog ;
@y
initialize ;
@z

@x
write_postamble ;
@y
write_postamble ;
while pk_count>0 do pk_byte(0);
close(pk_file,@=disposition:=save@>,@=error:=continue@>);
@z

@x
This section should be replaced, if necessary, by changes to the program
that are necessary to make \.{PXtoPK} work at a particular installation.
Any additional routines should be inserted here.
@^system dependencies@>
@y
Here are the remaining changes to the program
that are necessary to make \.{PXtoPK} work on Vax/VMS.

@<Const...@>==
@!VAX_block_length=512;

@ @<Types...@>==
@!byte_block=packed array [0..VAX_block_length-1] of 0..255;
@!int_block=packed array [0..127] of integer;

@ On Vax/VMS we need the following special definitions, types, variables
and procedures to be able to get the file name from the command line,
or to prompt for them.

@d VAX_status==@=status@>
@d VAX_direct==@=direct@>
@d VAX_fixed==@=fixed@>
@d VAX_volatile==@=volatile@>
@d VAX_immed==@=%immed @>
@d VAX_external==@=external@>
@d VAX_stdescr==@=%stdescr @>
@d VAX_lib_get_foreign==@= lib$get_foreign@>
@d VAX_length==@=length @>
@d VAX_fab_type==@= FAB$TYPE @>
@d VAX_rab_type==@= RAB$TYPE @>
@d VAX_xab_type==@= XAB$TYPE @>
@d VAX_fab_xab==@= FAB$L_XAB @>
@d VAX_xab_nxt==@= XAB$L_NXT @>
@d VAX_xab_cod==@= XAB$B_COD @>
@d VAX_xab_fhc==@= XAB$C_FHC @>
@d VAX_xab_ebk==@= XAB$L_EBK @>
@d VAX_xab_ffb==@= XAB$W_FFB @>

@ @<Types...@>=
@!sixteen_bits= 0..65535;

@ @<Glob...@>==
@!command_line:packed array[1..300] of char;
@!cmd_len:sixteen_bits;
@!cmd_i:integer;
@!file_name,@!def_file_name:varying [300] of char;
@!ask,@!got_file_name: boolean;

@ @<Preset init...@>=
cmd_i:=0;
VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
got_file_name:=cmd_i<=cmd_len;
if got_file_name then
        def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);

if got_file_name then begin
        if index(def_file_name,'.')<=index(def_file_name,']') then
           file_name:=def_file_name+'.PXL'
        else file_name:=def_file_name;
        open(pxl_file,file_name,@=readonly@>,,VAX_direct,
                VAX_fixed,,@=error:=continue@>);
        ask:=status(pxl_file)<>0;
        if ask then write_ln('Couldn''t open ',file_name);
        end
else ask:=true;
while ask do begin
        got_file_name:=false;
        write('PXL file: ');
        if eof then goto 9999;
        read_ln(file_name);
        open(pxl_file,file_name,@=readonly@>,,VAX_direct,
                VAX_fixed,,@=error:=continue@>);
        ask:=status(pk_file)<>0;
        if ask then write_ln('Couldn''t open ',file_name);
        end;

if got_file_name then begin
        cmd_i:=1;
        for cmd_len:=1 to def_file_name.VAX_length do
                if (def_file_name[cmd_len]=']')
                or (def_file_name[cmd_len]=':')
                then cmd_i:=cmd_len+1;
        if cmd_i<=def_file_name.VAX_length then
                def_file_name:=substr(def_file_name,cmd_i,
                        def_file_name.VAX_length-cmd_i+1);
        if index(def_file_name,'.')=0 then file_name:=def_file_name+'.PK'
        else if index(def_file_name,'PXL')=def_file_name.VAX_length-2 then begin
                        def_file_name[def_file_name.VAX_length-1]:='K';
                        file_name:=substr(def_file_name,
                                          1,def_file_name.VAX_length-1);
                        end
                else file_name:=def_file_name+'PK';
        open(pk_file,file_name,@=new,disposition:=delete@>,
                @=error:=continue@>);
        ask:=status(pk_file)>0;
        if ask then write_ln('Couldn''t open ',file_name);
        end
else ask:=true;
while ask do begin
        write('PK file: ');
        if eof then goto final_end;
        read_ln(file_name);
        if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
        open(pk_file,file_name,@=new,disposition:=delete@>,
                @=error:=continue@>);
        ask:=status(pk_file)>0;
        if ask then write_ln('Couldn''t open ',file_name);
        end;

@ Here is the library procedure that gets the user's command line.

@<Procedures for ...@>=
[VAX_external] function VAX_lib_get_foreign(
  VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
        := VAX_immed 0;
  VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
        := VAX_immed 0;
  var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
  var flag : [VAX_volatile] integer := VAX_immed 0)
    :integer; extern;
@z